      LOGICAL FUNCTION CHINCH(SOL,S)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     CHINCH DETERMINES IF THE STRING SOL (MINUS TRAILING BLANKS)      C
C     OCCURS IN THE STRING S.                                          C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER *(*) SOL,S
      DO 5 LE=LEN(SOL),1,-1
    5 IF (SOL(LE:LE).NE.' ') GOTO 6
    6 CHINCH=INDEX(S,SOL(1:LE)).NE.0
      RETURN
      END
      SUBROUTINE CLEARC(A,N)
C***********************************************************************
C     SUBROUTINE CLEARC
C***********************************************************************
C
      CHARACTER*(*) A(N)
C
      DO 1 I=1,N
    1 A(I)=' '
      RETURN
      END
      CHARACTER*(*) FUNCTION CRDSTR(STRING,K)
C
C=======================================================
C     READ CRDSTR FROM STRING UNTIL BLANK
C     RETURNCODE K = 0: STRING BLANK
C                  > 0: LENGTH OF DATA FIELD (MAX. 99)
C
      CHARACTER STRING*(*),BLANK*1
      DATA BLANK/' '/
      L=LEN(STRING)
C-------FIND FIRST NON-BLANK
      DO 10 I=1,L
   10 IF (STRING(I:I).NE.BLANK) GOTO 20
      K=0
      CRDSTR=BLANK
      RETURN
C-------FIND NEXT NON-BLANK
   20 DO 30 K=I+1,L
   30 IF (STRING(K:K).EQ.BLANK) GOTO 40
      K=L+1
   40 K=K-1
C-------COPY DATA FROM STRING
      CRDSTR=STRING(I:K)
C-------BLANK OUT DATA FIELD
      STRING(I:K)=BLANK
      K=K-I+1
      RETURN
      END
      SUBROUTINE IRDSTR(II,STRING,KK,*)
C
C=======================================================
C     READ INTEGER II FROM STRING
C     RETURNCODE KK = -1: READ FAILED (NO INTEGER IN FIELD); ALT. RETURN
C                   =  0: STRING BLANK
C                   >  0: LENGTH OF DATA FIELD (MAX. 99)
C     VALUE OF II CHANGED ONLY WHEN KK>0
C
      CHARACTER STRING*(*),BLANK*1,FMT*5
      DATA BLANK/' '/
      L=LEN(STRING)
C------- FIND FIRST NON-BLANK
      DO 10 I=1,L
   10 IF (STRING(I:I).NE.BLANK) GOTO 20
      KK=0
      RETURN
   20 DO 30 K=I+1,L
      ICH=ICHAR(STRING(K:K))
C------- LOOK FOR NON-DIGIT
   30 IF (ICH.LT.ICHAR('0').OR.ICH.GT.ICHAR('9')) GOTO 40
      K=L+1
   40 K=K-1
      L=K-I+1
      WRITE (FMT,'(''(I'',I2,'')'')') L
C------- READ INTEGER FROM FIELD
      READ (STRING(I:K),FMT,ERR=50) II
C------- BLANK OUT DATA FIELD IF SUCCESSFULL
      STRING(I:K)=BLANK
      KK=L
      RETURN
   50 KK=-1
      RETURN 1
      END
      SUBROUTINE RRDSTR(RR,STRING,KK,*)
C
C=======================================================
C     READ REAL RR FROM STRING
C     RETURNCODE KK = -1: READ FAILED (NO INTEGER IN FIELD); ALT. RETURN
C                   =  0: STRING BLANK
C                   >  0: LENGTH OF DATA FIELD (MAX. 99)
C     VALUE OF RR CHANGED ONLY WHEN KK>0
C
      CHARACTER STRING*(*),BLANK*1,FMT*7
      DATA BLANK/' '/
      L=LEN(STRING)
C-------FIND FIRST NON-BLANK
      DO 10 I=1,L
   10 IF (STRING(I:I).NE.BLANK) GOTO 20
      KK=0
      RETURN
C-------FIND NEXT NON-BLANK
   20 DO 30 K=I+1,L
   30 IF (STRING(K:K).EQ.BLANK) GOTO 40
      K=L+1
   40 K=K-1
      L=K-I+1
      WRITE (FMT,'(''(F'',I2,''.0)'')') L
C-------READ REAL FROM FIELD
      READ (STRING(I:K),FMT,ERR=50) RR
C-------BLANK OUT DATA FILED IF SUCESSFULL
      STRING(I:K)=BLANK
      KK=L
      RETURN
   50 KK=-1
      RETURN 1
      END
      INTEGER FUNCTION LENSTR(CHARS)
C
C---------- RETURNS LENGTH OF STRING 'CHARS' EXCLUDING TRAILING BLANKS
C
      CHARACTER*(*) CHARS
      MVAL = LEN(CHARS)
      DO 10 J = MVAL,1,-1
      IF (CHARS(J:J).NE.' ') GOTO 20
   10 CONTINUE
      J = 0
   20 LENSTR = J
      RETURN
      END
      SUBROUTINE LSHIFC(N,NAME)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     DELETE TRAILING BLANKS FROM A CHARACTER STRING BY SHIFTING       C
C     THE STRING TO THE LEFT AND FILLING RIGHT WITH BLANKS             C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER NAME*(*)
      DO 10 I=1,N
      IF (NAME(1:1).EQ.' ') THEN
        DO 5 J=2,N
    5   NAME(J-1:J-1)=NAME(J:J)
        NAME(N:N)=' '
      ENDIF
   10 CONTINUE
      RETURN
      END
      SUBROUTINE RSHIFC(N,NAME)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     DELETE TRAILING BLANKS FROM A CHARACTER STRING BY SHIFTING       C
C     THE STRING TO THE RIGHT AND FILLING LEFT WITH BLANKS             C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER NAME*(*)
      L=LEN(NAME)
      DO 10 I=1,N
      IF (NAME(L:L).EQ.' ') THEN
        DO 5 J=L,2,-1
    5   NAME(J:J)=NAME(J-1:J-1)
        NAME(1:1)=' '
      ENDIF
   10 CONTINUE
      RETURN
      END
      CHARACTER*(*) FUNCTION UPPRCS(STRING)
C
C=======================================================
C     UPPRCS IS 'UPPERCASE' OF STRING
C     NON-ALPHABETIC CHARACTERS ARE RETAINED
C
      CHARACTER*(*) STRING
      UPPRCS=' '
      ICHA=ICHAR('a')
      ICHZ=ICHAR('z')
      IOF=ICHA-ICHAR('A')
      DO 25 J=1,MIN0(LEN(STRING),LEN(UPPRCS))
          IB=ICHAR(STRING(J:J))
          IF (IB.GE.ICHA.AND.IB.LE.ICHZ) IB=IB-IOF
          UPPRCS(J:J)=CHAR(IB)
   25 CONTINUE
      RETURN
      END
      CHARACTER*(*) FUNCTION LOWRCS(STRING)
C
C=======================================================
C     LOWRCS IS 'LOWERCASE' OF STRING
C     NON-ALPHABETIC CHARACTERS ARE RETAINED
C
      CHARACTER*(*) STRING
      LOWRCS=' '
      ICHA=ICHAR('A')
      ICHZ=ICHAR('Z')
      IOF=ICHAR('a')-ICHA
      DO 25 J=1,MIN0(LEN(STRING),LEN(LOWRCS))
          IB=ICHAR(STRING(J:J))
          IF (IB.GE.ICHA.AND.IB.LE.ICHZ) IB=IB+IOF
          LOWRCS(J:J)=CHAR(IB)
   25 CONTINUE
      RETURN
      END
      SUBROUTINE ZERO(A,N)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE ZERO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION A(N)
      DO 1 I=1,N
    1 A(I)=0.
      RETURN
      END
      SUBROUTINE COPY(A,B,N)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE COPY
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      DIMENSION A(N),B(N)
      DO 10 I=1,N
      B(I)=A(I)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE CURV (GRAN1,GRAN2,NPTS,GR)
C
CCCCC H.J.C.BERENDSEN/W.F.VAN GUNSTEREN, GRONINGEN, SEPT.79 CCCCCCCCCCCC
C                                                                      C
C     SUBROUTINE CURV (GRAN1,GRAN2,NPTS,GR)                            C
C                                                                      C
COMMENT   CURV WILL PLOT A FUNCTION GR(R) OF EQUALLY SPACED DATA       C
C     POINTS ON THE LINE PRINTER. THE ABCIS IS PRINTED VERTICALLY.     C
C                                                                      C
C     GRAN1 = LOWER LIMIT OF R                                         C
C     GRAN2 = UPPER LIMIT OF R                                         C
C     NPTS = NUMBER OF DATA POINTS                                     C
C     GR = ORDINATE VALUES (LENGTH NPTS)                               C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      DIMENSION GR(1),PRT(107)
      DATA BLANC,HOR,VERT,SYMBL/1H ,1HI,1HT,1H*/
  101 FORMAT(1H0,////////////)
  102 FORMAT(1HT)
  103 FORMAT(1HS)
C*****1HS=6 LINES PER INCH
C*****1HT=8 LINES PER INCH
      PRINT 102
      PRINT 101
  105 FORMAT(1X,E11.4,1X,E11.4,1X,107A1)
  106 FORMAT(1X,E11.4,13X,107A1)
  107 FORMAT (1H1)
      KMAX=1
      GMAX=0.E0
      KMIN=1
      GMIN=0.E0
      DO 110 K=1,NPTS
      IF (GR(K).GE.GMIN) GOTO 109
      KMIN=K
      GMIN=GR(K)
  109 CONTINUE
      IF (GR(K).LE.GMAX) GOTO 110
      KMAX=K
      GMAX=GR(K)
  110 CONTINUE
      IF (GMAX.NE.GMIN) GOTO 112
      PRINT 111,GMAX
  111 FORMAT(1X,71HSUBR. CURV RETURNED BECAUSE MINIMUM AND MAXIMUM VALUE
     2 ARE BOTH EQUAL TO,E11.4)
      GOTO 300
  112 SCALE=106.E0/(GMAX-GMIN)
      B=(GRAN2-GRAN1)/(NPTS-1)
      A=GRAN1-B
      DO 200 K=1,NPTS
      PRT(1)=HOR
      PRT(107)=HOR
      NR=(GR(K)-GMIN)*SCALE+1.001E0
      IF (K.EQ.1.OR.K.EQ.NPTS) GOTO 115
      DO 114 I=2,106
  114 PRT(I)=BLANC
      PRT(NR)=SYMBL
      IF (K-1.EQ.K/10*10) GOTO 140
      PRINT 106,GR(K),(PRT(I),I=1,107)
      GOTO 200
  115 CONTINUE
      DO 130 I=1,107
  130 PRT(I)=VERT
      PRT(NR)=SYMBL
  140 CONTINUE
      X=A+B*K
      PRINT 105,GR(K),X,(PRT(I),I=1,107)
  200 CONTINUE
  300 CONTINUE
      PRINT 103
      PRINT 107
      RETURN
      END
      SUBROUTINE SCURV(NI,NT,IAF,NPTS,GRAN1,GRAN2,GR,NW,FMT,*)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
COMMENT SUBROUTINE SCURV                                               C
C                                                                      C
C  AUTHOR: JAC RULLMANN, GRONINGEN, APRIL 1981                         C
C  BASED ON SUBROUTINE CURV BY WF VAN GUNSTEREN EN HJC BERENDSEN       C
C                                                                      C
C  SCURV PLOTS A FUNCTION GR(R) OF EQUALLY SPACED DATA ON A LINE PRINTER
C  OR TERMINAL. THE ABCIS IS PRINTED VERTICALLY. THE ORDINATE VALUES   C
C  ARE PRINTED WITHIN A WINDOW OF ADJUSTABLE WIDTH. ALSO, THE DATA     C
C  PRINTING FORMAT IS ADJUSTABLE.                                      C
C                                                                      C
C  SCURV IS INTENDED FOR BATCH AND INTERACTIVE USE.                    C
C  SCURV IS WRITTEN IN FORTRAN 5, THE CDC VERSION OF ANSI FORTRAN 77.  C
C                                                                      C
C  FORMAL PARAMETERS:                                                  C
C  GRAN1  = LOWER LIMIT OF R                                           C
C  GRAN2  = UPPER LIMIT OF R                                           C
C  NPTS   = NUMBER OF DATA POINTS                                      C
C  GR     = ORDINATE VALUES (ARRAY OF VARIABLE SIZE; ACTUAL ARRAY      C
C           SHOULD HAVE A LENGTH OF AT LEAST NPTS)                     C
C  NSTART = ARRAY INDEX OF THE FORMAL PARAMETER GR(NSTART) THAT COR-   C
C           RESPONDS TO THE ACTUAL ARRAY-ELEMENT CONTAINING THE FIRST  C
C           ORDINATE VALUE (I.E. THE VALUE BELONGING TO GRAN1)         C
C  IAF    = IF TRUE INTERACTIVE JOB IS ASSUMED                         C
C  NI     = FILE INDEX OF INPUTFILE                                    C
C  NT     = FILE INDEX. PLOT OUTPUT IS WRITTEN TO TAPE(NT). (IN BATCH  C
C           JOBS OR ON FILES OTHER THAN TAPE2 10 BLANK LINES ARE       C
C           PRINTED ABOVE AND BELOW THE PLOT)                          C
C  NW     = PHYSICAL DIMENSION (I.E. NUMBER OF CHARACTERS) OF THE      C
C           ORDINATE AXIS IN A BATCH JOB. IF NW<1 OR >106 NW IS        C
C           CHANGED TO 106. IN INTERACTIVE JOBS NW IS NOT USED, BUT    C
C           THE CORRESPONDING PARAMETER IS FETCHED INTERACTIVELY       C
C  FMT    = DATA PRINTING FORMAT (CHARACTER STRING BETWEEN APO-        C
C           STROPHES) IN A BATCH JOB. IF FMT=' ' THEN FMT IS CHANGED   C
C           TO 'G11.4'. IN INTERACTIVE JOBS FMT IS NOT USED, BUT THE   C
C           CORRESPONDING PARAMETER IS FETCHED INTERACTIVELY           C
C                                                                      C
C  THE SUBROUTINE RETURNS TO THE ALTERNATE RETURN LABEL.               C
C                                                                      C
C  INPUT/OUTPUT:                                                       C
C  PLOT AND DATA ARE WRITTEN TO TAPE(NT). IN INTERACTIVE JOBS COMMU-   C
C  NICATION PROCEEDS VIA FILES INPUT AND OUTPUT. IN BATCH JOBS NO      C
C  INPUT IS REQUIRED.                                                  C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER PRT(107),BLANC,HOR,VERT,SYMBL,
     +          FMA*10,FMB*2,FM(2)*40,FMT*10
      LOGICAL IAF
      DIMENSION GR(*)
      SAVE NWID,FMA,NEW
      DATA BLANC,HOR,VERT,SYMBL/' ','I','T','*'/,NEW/1/
      DATA NSTART/1/
  101 FORMAT(10(/))
  103 CONTINUE
      IF (IAF) THEN
        IF (NEW.EQ.1) THEN
          NWID=NW
          FMA=FMT
          NEW=0
        END IF
        PRINT 104,NWID,FMA
  104   FORMAT(' (ENTERING SUBROUTINE SCURV)'/
     +  ' TYPE IN NWID,''FMA'''/' NWID=NUMBER OF POINTS ON',
     +  ' ORDINATE, DEFAULT VALUE',I5/
     +  ' FMA=DATA EDIT DESCRIPTOR, DEFAULT ',A10/
     +  ' (NWID + 2*FIELD-WIDTH) SHOULD NOT EXCEED 75 (TERMINAL)',
     +  ' OR 128 (PRINTER)'/' NWID SHOULD BE < 107')
        READ (NI,*) NWID,FMA
        ELSE
        NWID=106
        FMA='G11.4'
        IF (NW.GT.0.AND.NW.LT.107) NWID=NW
        IF (FMT.NE.BLANC) FMA=FMT
      END IF
      IF (FMA(3:3).NE.'.') THEN
        IF (FMA(4:4).NE.'.') THEN
          PRINT *,'BAD DATA EDIT DESCRIPTOR (FMT OR FMA)'
          IF (.NOT.IAF) RETURN 1
          GOTO 103
        END IF
        FMB=FMA(2:3)
        ELSE
        FMB=BLANC//FMA(2:2)
      END IF
      READ (FMB,'(I2)') L
      L=L+2
      WRITE (FMB,'(I2)') L
      FM(1)='(1X,'//FMA//','//FMB//'X,107A1)'
      FM(2)='(1X,'//FMA//',1X,'//FMA//',1X,107A1)'
      KMAX=NSTART
      GMAX=GR(NSTART)
      KMIN=NSTART
      GMIN=GMAX
      NW1=NWID+1
      DO 110 K=NSTART,(NSTART+NPTS-1)
      IF (GR(K).LT.GMIN) THEN
        KMIN=K
        GMIN=GR(K)
      END IF
      IF (GR(K).GT.GMAX) THEN
        KMAX=K
        GMAX=GR(K)
      END IF
  110 CONTINUE
      IF (GMAX.EQ.GMIN) THEN
        SCALE=NWID/GMAX
        ELSE
        SCALE=NWID/(GMAX-GMIN)
      END IF
      B=(GRAN2-GRAN1)/(NPTS-1)
      A=GRAN1-B
      IF (.NOT.IAF.OR.NT.NE.2) WRITE (NT,101)
      DO 200 KX=1,NPTS
      K=KX+NSTART-1
      PRT(1)=HOR
      PRT(NW1)=HOR
      NR=(GR(K)-GMIN)*SCALE+1.000001E0
      IF (KX.EQ.1.OR.KX.EQ.NPTS) GOTO 115
      DO 114 I=2,NWID
  114 PRT(I)=BLANC
      PRT(NR)=SYMBL
      IF (KX-1.EQ.KX/10*10) GOTO 140
      WRITE (NT,FM(1)) GR(K),(PRT(I),I=1,NW1)
      GOTO 200
  115 CONTINUE
      DO 130 I=1,NW1
  130 PRT(I)=VERT
      PRT(NR)=SYMBL
  140 CONTINUE
      X=A+B*KX
      WRITE (NT,FM(2)) GR(K),X,(PRT(I),I=1,NW1)
  200 CONTINUE
  300 CONTINUE
      IF (.NOT.IAF.OR.NT.NE.2) WRITE (NT,101)
      RETURN 1
      END
      SUBROUTINE PLOTGR (NINT,GR)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     SUBROUTINE PLOTGR (NINT,GR)                                      C
C                                                                      C
COMMENT   PLOTGR WILL PLOT A FUNCTION GR(R) OF EQUALLY SPACED DATA     C
C     POINTS ON THE LINE PRINTER. THE ABCIS IS PRINTED HORIZONTALLY.   C
C                                                                      C
C     NINT = NUMBER OF INTERVALS                                       C
C     GR = ORDINATE VALUES (LENGTH NINT, NINT < 129)                   C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      DIMENSION GR(1),INP(128)
      REAL OUTPUT(132),ZERO(132),BLANK,X
      DATA ZERO /1H+,1H ,1H ,1H ,128*1H-/ ,BLANK /1H / ,X /1HX/
      DATA OUTPUT(1)/1H+/,OUTPUT(2)/1H /,OUTPUT(3)/1H /,OUTPUT(4)/1H /
    1 FORMAT(//,11H 25 UNITS =,E16.8)
    2 FORMAT(1X,I3)
    3 FORMAT(132A1)
      GMAX= ABS(GR(1))
      DO 10 N=2,NINT
      GN= ABS(GR(N))
      IF (GN.GT.GMAX) GMAX=GN
   10 CONTINUE
      NMAX=NINT
      IF (NMAX.GT.128) NMAX=128
      LMAX=NMAX+3
      PRINT 1,GMAX
      DO 20 N=1,NMAX
   20 INP(N)=25.E0*GR(N)/GMAX+0.5E0
      LINE=25
   30 CONTINUE
      PRINT 2,LINE
      IF (LINE.EQ.0) PRINT 3,ZERO
      L=4
      IB=4
   40 L=L+1
      IF (L.GT.LMAX) GOTO 50
      OUTPUT(L)=BLANK
      IF (INP(L-4).NE.LINE) GOTO 40
      OUTPUT(L)=X
      IB=L
      GOTO 40
   50 PRINT 3,(OUTPUT(I),I=1,IB)
      LINE=LINE-1
      IF (LINE.LT.-25) RETURN
      GOTO 30
      END
      SUBROUTINE PRTMAT(A,N,M,NSYM,RF)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C     SUBROUTINE PRTMAT                                                C
C                                                                      C
C PRINTS MATRIX A(N,M). ROWS AND COLUMS LABELED WITH NUMBERS.          C
C NSYM :                                                               C
C       =1 LOWER TRIANGLE IS PRINTED. A SHOULD BE 2-DIMENSIONAL.       C
C       =2 ALL ELEMENTS ARE PRINTED. A SHOULD BE 2-DIMENSIONAL.        C
C       =3 LOWER TRIANGLE IS PRINTED. THE SUB DIAGONAL ELEMENTS        C
C          SHOULD BE PROVIDED AS A VECTOR.                             C
C       =4 IDEM AS 3, BUT DIAGONAL IS ABSENT.                          C
C       =ELSE  IDEM AS 2.                                              C
C RF   :FORMAT FOR PRINTING ELEMENTS (E.G. F12.5).                     C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      DIMENSION A(N,M)
      CHARACTER RF*(*), RFMT*6, FMA*11, FMB*14
      RFMT=RF
      READ (RFMT,10) R
      I=R
      JJ=132/I
      WRITE (FMA,20) JJ,I
      WRITE (FMB,30) JJ,RFMT
      DO 1 JF=1,M,JJ
        JL=MIN0(JF+JJ-1,M)
            JLL=JL
        IF=1
        IF(NSYM.EQ.1.OR.NSYM.EQ.3.OR.NSYM.EQ.4) IF=JF
        PRINT FMA, (J,J=JF,JL)
        DO 1 I=IF,N
           K=I
           IF (NSYM.EQ.4) K=I-1
           IF(NSYM.EQ.1.OR.NSYM.EQ.3.OR.NSYM.EQ.4) JLL=MIN0(K,JL)
           IF(NSYM.NE.3.AND.NSYM.NE.4) THEN
             PRINT FMB,I,(A(I,J),J=JF,JLL)
             GOTO 1
           ENDIF
           PRINT FMB,I,(A(K*(K-1)/2+J,1),J=JF,JLL)
    1 CONTINUE
   10 FORMAT(1X,F5.2)
   20 FORMAT( '(/5X,' , I2 , 'I' , I2 , ')' )
   30 FORMAT( '(I5,' , I2 , A6 , ')' )
      END
      SUBROUTINE PACKT (R,ARRAY,IARRAY,NTOT,MODE,NDIGIT,NTAP,NTPW)
C
CCCCCC W.F. VAN GUNSTEREN, GRONINGEN, MAR. 1983 CCCCCCCCCCCCCCCCCCCCCCCC
C      J.A.C. RULLMANN, UTRECHT, NOV. 1989                             C
C                                                                      C
C     SUBROUTINE PACKT (R,ARRAY,IARRAY,NTOT,MODE,NDIGIT,NTAP,NTPW)     C
C                                                                      C
COMMENT   PACK WRITES OR READS THE ARRAY R TO OR FROM DISC.            C
C     THE STRUCTURE OF THE ROUTINE INCLUDING THE CALL IS THE SAME      C
C     AS THAT OF THE GROMOS ROUTINE PACK. HOWEVER SOME OPTIONS         C
C     ARE NOT USED (NTPW=1,3), AND VARIABLE MODE IS OF TYPE CHAR*4.    C
C                                                                      C
C     R(1.. ) = ARRAY TO BE WRITTEN OR READ                            C
C                                                                      C
C     ARRAY,IARRAY(1.. ) = DUMMY ARRAYS (NEEDED FOR NTPW=1)            C
C                                                                      C
C     NTOT = NUMBER OF ARRAY ELEMENTS IN R TO BE WRITTEN OR READ       C
C                                                                      C
C            NOTE: NTOT IS ALSO WRITTEN TO FILE (THIS IS DIFFERENT     C
C                  FROM THE GROMOS ROUTINE!). ON READING THE VALUE     C
C                  ON FILE IS CHECKED AGAINST THE VALUE SUPPLIED AS    C
C                  ARGUMENT WHEN THE LATTER IS NOT 0.                  C
C                                                                      C
C     MODE = PACK : R WILL BE WRITTEN                                  C
C          = UNPA : R WILL BE READ                                     C
C                                                                      C
C     NDIGIT = DUMMY (NEEDED FOR NTPW=1)                               C
C                                                                      C
C     NTAP = TAPE UNIT NUMBER FOR WRITING OR READING                   C
C                                                                      C
C     NTPW = 0 : READING OR WRITING IN BINARY FORM                     C
C          = 1 : FLOATING POINT NUMBERS ARE PACKED OR UNPACKED USING   C
C                ASSEMBLER SUBRS. SIZEI, PCK AND UCK                   C
C                (ONLY ON CDC CYBER 170/760 MACHINES)                  C
C          = 2 : READING OR WRITING IN FORMATTED FORM (10F8.3)         C
C          = 3 : READING IN STANDARD FORMATTED FORM                    C
C                                                                      C
C          NOTE: NTPW = 1 AND NTPW = 3 ARE NOT USED!                   C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*4 MODE,MPACK,MUNPA
      DIMENSION R(*),ARRAY(*),IARRAY(*)
      DATA MPACK,MUNPA/'PACK','UNPA'/
C
      IF (NTPW.EQ.0) THEN
         IF (MODE.EQ.MPACK) THEN
            WRITE (NTAP) NTOT
            WRITE (NTAP) (R(K),K=1,NTOT)
         ELSE IF (MODE.EQ.MUNPA) THEN
            READ (NTAP) NTOT2
            IF (NTOT.NE.0.AND.NTOT.NE.NTOT2) CALL ABORT
     +      ('F',6,'DATA INCONSISTENT WITH NTOT IN CALL TO PACKT',
     +      0,0,999)
            READ (NTAP) (R(K),K=1,NTOT2)
         ELSE
            CALL ABORT('F',6,'UNKNOWN MODE:'//MODE//
     +                 ' IN CALL TO PACKT',0,0,999)
         ENDIF
      ELSE IF (NTPW.EQ.2) THEN
         IF (MODE.EQ.MPACK) THEN
            WRITE (NTAP,11) NTOT
            WRITE (NTAP,12) (R(K),K=1,NTOT)
         ELSE IF (MODE.EQ.MUNPA) THEN
            READ (NTAP,11) NTOT2
            IF (NTOT.NE.0.AND.NTOT.NE.NTOT2) CALL ABORT
     +      ('F',6,'DATA INCONSISTENT WITH NTOT IN CALL TO PACKT',
     +      0,0,999)
            READ (NTAP,12) (R(K),K=1,NTOT2)
         ELSE
            CALL ABORT('F',6,'UNKNOWN MODE:'//MODE//
     +                 ' IN CALL TO PACKT',0,0,999)
         ENDIF
      ELSE
         CALL ABORT('F',6,'NTPW OPTION NOT IMPLEMENTED IN PACKT',
     +             0,0,999)
      ENDIF
C
   11 FORMAT (I6)
   12 FORMAT (10F8.3)
C
      RETURN
      END
